(in-package :ecocyc)


;;
;; Function: pwy2cobra
;; Returns:  NIL
;; Arguments: filename - output file
;;            pwy - a pathway frame
;;            &key
;;            :boundary-metabolites - a list of metabolites that are not balanced.  If empty, by default it attempts
;;             to guess the boundary metabolites by looking for dead-end metabolites.
;;            :objective - an assoc list of reactions and objective coefficients. 
;;            All reactions not listed are assumed to have an objective coefficient of 0.
;;           
;; Side Effects:
;;           generates a cobra-compliant sbml model of the pathway with reaction directions
;;           determined by pathway flow
;; Examples: (pwy2cobra "glycolysis.xml" 'glycolysis)
;;
(defun pwy2cobra (filename pwy &key boundary-metabolites objective)
  (let ((*pathway* pwy))
    (2cobra filename
	    (rxns-of-pwy pwy)
	    :org-id pwy
	    :boundary-metabolites (or boundary-metabolites (get-boundary-metabolites pwy))
	    :objective objective)))


;;  Function: rxns-of-pwy
;;  Returns:  list of all reactions in the pathway
;;  Arguments:  pwy - a pathway ID
;;  
;;  recursively searches subpathways for reactions of pathway.

(defun rxns-of-pwy (pwy)
  (loop for rxn in (get-slot-values pwy 'reaction-list)
     ;if (get-slot-values rxn 'reaction-list)
     if (class-all-type-of-p '|Pathways| rxn)
     append (rxns-of-pwy rxn)
     else collect rxn))


(defun smm-transport-rxns2cobra (filename &optional (org-id 'ecoli))
  (2cobra filename
	 (append (all-rxns :metab-smm)
		 (all-rxns :transport))
	 org-id))

(defun balanced-rxns2cobra (filename &optional (org-id 'ecoli))
  (2cobra filename
	 (append (all-rxns :metab-smm)
		 (all-rxns :transport))
	 org-id
	 #'sbml-balanced-p))

(defun get-pwy-secondaries (pwy)
  (set-difference (compounds-of-pathway pwy) (get-pwy-primaries pwy)))

(defun get-boundary-primaries (pwy)
  (let ((r-of-pwy (rxns-of-pwy pwy)))
    (loop for primary in (get-pwy-primaries pwy)
       for rxns-of-primary = (reactions-of-compound primary)
	 when (>= 1 (length (intersection rxns-of-primary r-of-pwy)))
	 collect primary)))
(defun get-boundary-metabolites (pwy)
  (append (get-pwy-secondaries pwy) (get-boundary-primaries pwy)))


;; Function: 2cobra
;; Returns:  NIL
;; Arguments: filename - output file
;;            rxn-list - a list of reaction frames
;;            org-id - the biocyc :org-id (default ecoli)
;;            filter-p - a boolean function that takes a single reaction 
;;                       frame as a parameter
;; Examples: (2cobra "ecoli-transport.xml" (all-rxns :transport))
;;           (2cobra "metacyc-transport.xml" (all-rxns :metab-smm) 'meta)
;;           (2cobra "balanced-metacyc.xml" (all-rxns) 'meta #'sbml-balanced-p)
;; jz:Aug-30-2006 Changed the filter-p argument to default to substrates-of-reaction if no filter is given.
;;                This ensures that all reactions have at least one reactant or product.
;; jdz:Aug-30-2006 altered call to make-sbml to ensure that the reaction list is nonredundant.
;;
(defun 2cobra  (filename rxn-list &key org-id boundary-metabolites objective)
  (print-sbml filename org-id rxn-list :boundary-metabolites boundary-metabolites :objective objective))



;; Function: rxn-filter - screens a list of reactions for offending criteria
;; Returns: a list of reactions
;; Arguments: rxn-list - a list of reaction frames
;;            filter-p - a boolean function that takes a reaction frame as an argument
;; Examples: (rxn-filter (all-rxns) #'sbml-balanced-p)
;; jdz:Aug-30-2006  altered rxn-filter to always check if a reaction has at least one reactant or product.

(defun rxn-filter (rxn-list filter-p)
  (loop for rxn in rxn-list
      when (and (funcall filter-p rxn)
		(substrates-of-reaction rxn))
      collect rxn))

;; Function: sbml-balanced-p - checks to see if all substrates of a reaction have a molecular weight. (It actually does not currently check to see if the reaction is balanced)
;; Returns:  boolean - t if the reaction is balanced, 'nil otherwise
;; Arguments: rxn - a reaction frame
;; Example:  (sbml-balanced-p '|CITRATE-(RE)-SYNTHASE-RXN|) ==> t
;;           (sbml-balanced-p 'THIOREDOXIN-REDUCT-NADPH-RXN) ==> NIL
;;
(defun sbml-balanced-p (rxn)
  (let* ((balanced t))
    (loop for substrate in (substrates-of-reaction rxn)
	do (if (equal 0 (get-molecular-weight substrate))
	       (setq balanced 'nil)))
    balanced)
  )

(defun get-molecular-weight (metabolite)
  (or (and (coercible-to-frame-p metabolite)
	   (get-slot-value metabolite 'molecular-weight))
      0))

(defun print-sbml (filename org-id rxn-list  &key boundary-metabolites objective)
  (let ((stream t))
    (tofile filename
      (print-header org-id stream)
      (print-list-of-compartments (get-list-of-compartments rxn-list) stream)
      (print-list-of-species rxn-list stream boundary-metabolites)
      (print-list-of-reactions rxn-list stream objective)
      (print-footer stream))))

;; This function returns an SBML string to the standard output
;; Returns: NIL
;; Arguments: org-id - Biocyc id of the organism
;;            rxn-list - list of reaction frames
;; Example usage:  
;;         (make-sbml 'ecoli (all-rxns :metab-smm))
;; jdz:Aug-30-2006 Added get-list-of-compartments call to account for CCO
;;
(defun make-sbml (org-id rxn-list &key (stream *standard-output*) boundary-metabolites objective)
    (unless stream
      (setq stream *standard-output*))
    (so org-id)
    (clim:noting-progress 
     ((listener) (format nil "Exporting reactions to SBML file ~a" *sbml-export-file-name*))
     (print-header org-id stream)
     (clim:note-progress 0 4)
     (print-list-of-compartments (get-list-of-compartments rxn-list) stream)
     (clim:note-progress 1 4)
     (print-list-of-species rxn-list stream boundary-metabolites)
     (clim:note-progress 2 4)
     (print-list-of-reactions rxn-list stream objective)
     (clim:note-progress 3 4)
     (print-footer stream)
     (clim:note-progress 4 4)))

;; This function uses the Cell component ontology to generate a list of compartments
;; Returns a list of CCO compartments
;; Arguments:  rxn-list - a list of reaction frames
;; 
;; Example-usage:
;;     (get-list-of-compartments (all-rxns :transport))
;; jdz:Aug-30-2006 created this function to comply with the use of the Cell component ontology
;;
(defun get-list-of-compartments (rxn-list)
  (let ((compartment-list '()))
    (loop for rxn in rxn-list
      do (loop for direction in '(left right)
	   do (loop for substrate in (get-slot-values rxn direction)
		for compartment = (compound-location substrate rxn direction)
		when (and compartment (not (member-p compartment compartment-list :test 'fequal)))
		do (pushnew compartment compartment-list))))
    compartment-list))
	   

(defun print-header (org-id stream)
    (let ((foobar "http://www.sbml.org/sbml/level2"))
      (format stream "<?xml version=\"1.0\" encoding=\"UTF-8\"?>~%<sbml xmlns=\"~A\" version=\"1\" level=\"2\">~%" foobar)
      (format stream "<model id=\"~A\" name=\"Generated from BioCyc Pathway/Genome Database\">~%" org-id)
      (format stream "<listOfUnitDefinitions>
	<unitDefinition id=\"mmol_per_gDW_per_hr\">
		<listOfUnits>
			<unit kind=\"mole\" scale=\"-3\"/>
			<unit kind=\"gram\" exponent=\"-1\"/>
			<unit kind=\"second\" multiplier=\".00027777\" exponent=\"-1\"/>
		</listOfUnits>
	</unitDefinition>
</listOfUnitDefinitions>
")

))

;; prints the list of compartments in SBML format
;; Returns to the stream writer the listOfCompartments 
;; Arguments:  compartment-list - a list of compartment frames (From the CCO)
;;             stream - the output stream to write.
;; jdz: Aug-30-2006 altered this to take into account nil compartments (default is cco-cytoplasm)
(defun print-list-of-compartments (compartment-list stream)
  (format stream "<listOfCompartments>~%")
  (loop for compartment in compartment-list
    do (format stream "  <compartment id=\"~A\" name=\"~A\"/>~%" (if compartment (get-sid compartment) (get-sid 'cco-cytoplasm) )(if compartment compartment 'cco-cytoplasm)))
  (format stream "</listOfCompartments>~%"))


(defun print-list-of-species (rxn-list stream boundary-metabolites)
  (format stream "<listOfSpecies>~%")
  ;;(print-substrate-species rxn-list stream)
  (print-smm-species rxn-list stream boundary-metabolites)
  ;;  (print-enzyme-species rxn-list stream)
  (format stream "</listOfSpecies>~%"))

(defun get-rxn-name (fname)
  (if (coercible-to-frame-p fname)
      (format nil "~A: ~A" 
	      (get-name-string fname :rxn-eqn-as-name? nil :strip-html? t) 
	      (get-name-string fname :rxn-eqn-as-name? t :strip-html? t))
    fname))

;;;kr:Oct-9-2008 Comment: Note that there is a similar fn called (print-formula ...) , which however
;;; formats for CLIM and WWW output.
;;;
(defun print-chemical-formula (compound)
  (let* ((cf ""))
    (if (and (coercible-to-frame-p compound) 
	     (get-slot-values compound 'chemical-formula))
	(loop for pair in (sort-formula (get-slot-values compound 'chemical-formula))
	    do (if (equal (cadr pair) 1)
		   ;;kr:May-1-2006 Using (get-name-string ...) here, because it is more forgiving when a frame is missing.
		   (setq cf (format nil "~A~A" cf (get-name-string (car pair) :strip-html? t)))
		 (setq cf (format nil "~A~A~A" cf (get-name-string (car pair) :strip-html? t) (cadr pair))))))
    cf))


(defun sbml-get-cpd-name (fname)
  (if (coercible-to-frame-p fname)
      (format nil "~A: ~A" 
	      (get-name-string fname :rxn-eqn-as-name? nil :strip-html? t) 
	      (print-chemical-formula fname))
    fname))


(defun print-list-of-reactions (rxn-list stream objective)
  (format stream "<listOfReactions>~%")
  (loop for rxn in rxn-list
    as id = (get-sid rxn)
    as name = (html-encode (get-frame-name rxn))
    as rxn-direction = (get-rxn-direction-from-pwy rxn)
    do  (print-reaction id name rxn-direction stream (cdr (assoc (get-frame-name rxn) objective))))
  (format stream "</listOfReactions>~%"))

;; cytoplasmic-substrates-of-reaction is now obsolete
;; Returns a list of substrates that are in the cytoplasm (compartment is nil)
;; Arguments rxn - the reaction frame id.
;; jdz:Aug-30-2006 This function is no longer needed.  Transport reaction handler handles this as a special case

(defun cytoplasmic-substrates-of-reaction (rxn)
  (loop for substrate in (substrates-of-reaction rxn)
    when (or (and (member-p substrate (get-slot-values  rxn 'left) :test 'fequal)
		  (fequal nil (get-value-annot rxn 'left substrate 'compartment)))
	     (and (member-p substrate (get-slot-values  rxn 'right) :test 'fequal)
		  (fequal nil (get-value-annot rxn 'right substrate 'compartment))))
    collect substrate))

;; print-substrate-species is now obsolete
;; Returns a list of species that are in the cytoplasm	      
;; Arguments rxn-list - list of reaction frame ids
;;           stream - output stream
;; jdz:Aug-30-2006 obsolete. now print-transported-species handles this as a special case
;(defun print-substrate-species (rxn-list stream)
;  (loop for substrate in (extract-list rxn-list #'cytoplasmic-substrates-of-reaction)
;    do (print-species (get-sid substrate) 
;		      (get-cycid substrate) 
;		      (get-sid 'cco-cytoplasm)
;		      'nil
;		      stream)))

;; print-smm-species returns the species id and the compartment of small molecule species
;; Returns  prints out the list of species
;; Arguments rxn-list - list of reaction frame ids
;;           stream - output stream
;; This now handles all small molecule species
(defun print-smm-species (rxn-list stream boundary-metabolites)
  (loop for transported-species in (extract-list rxn-list #'transported-compounds)
    for species = (car transported-species)
    for compartment = (cadr transported-species)
    do (print-species (get-transport-sid species compartment)
		      (get-cycid species)
		      (get-sid compartment)
		      'nil
		      stream (if (member (get-cycid species) boundary-metabolites :test #'fequal) "true" "false"))))
  
;; print-enzyme-species prints out the enzyme species
;; Returns SBML species for which the species is an enzyme.  Adds gene info, too.
;; Arguments rxn-list - list of reaction ids
;;           stream - output stream
;; jdz:Aug-30-2006 Altered the reaction to ensure no duplicate enzymes (for enzymes that also act as substrates of a reaction.)
(defun print-enzyme-species (rxn-list stream)
  (let ((species-list     (extract-list rxn-list #'transported-compounds)))
    (loop for enzyme in  (extract-list rxn-list #'enzymes-of-reaction)
      when (not (member-p (list enzyme 'cco-cytoplasm) species-list :test 'fequal))
      do (print-species (get-sid enzyme) 
			(get-cycid enzyme) 
			(get-sid 'cco-cytoplasm)
			#'print-enzyme-annotation
			stream))))

(defun print-footer (stream)
  (format stream "</model>~%</sbml>~%"))


(defun transported-compound-p (rxn compound)
  (or (get-value-annot rxn 'left compound 'compartment)
      (get-value-annot rxn 'right compound 'compartment)))

;; Transported-compounds 
;; Returns the set of substrates that are transported
;; Arguments rxn - the reaction frame id
;; jdz:Aug-30-2006  wrote this function to replace transported-chemicals, which was
;;                  not returning the right list of compounds.
;;
(defun transported-compounds (rxn)
  (let ((substrates '()))
    (loop for direction in '(left right)
      do (loop for cpd in (get-slot-values rxn direction)
	   when (not (member-p (list cpd (compound-location cpd rxn direction)) substrates :test 'fequal))
	   do (pushnew (list cpd (compound-location cpd rxn direction)) substrates)))
    substrates))



;; Function: extract-list - finds unique derived elements of a list
;; Returns: A unique list of elements derived from the extraction function applied to the input list
;; Arguments: the-list - a list of frames
;;            extraction-function - a function which returns a list and takes an element of the-list as an argument
;; Examples: (extract-list (all-rxns :transport) #'transported-compounds)
;;           (extract-list (all-rxns :metab-smm) #'substrates-of-reaction)
;;           (extract-list (all-rxns :enzyme) #'enzymes-of-reaction)

;; jdz:Aug-30-2006 altered this function to ensure the extracted-list is nonredundant.  Thus, *extract-hash* is no longer needed
;;(defparameter *extract-hash* (make-hash-table :test 'equal))

;;
(defun extract-list (the-list extraction-function)
  (let ((extract-list '())) 
   (loop for element in the-list
      when (coercible-to-frame-p element)
      do (loop for extract-element in (funcall extraction-function element)
	   when (not (member-p extract-element  extract-list :test 'fequal))
	   do (pushnew extract-element extract-list)))
   extract-list))


(defun print-species (id name compartment annotation stream &optional boundary-condition)
  (format stream "  <species id=\"~A\" name=\"~A\"  initialAmount=\"1000\" compartment=\"~A\" boundaryCondition=\"~A\"" id (html-encode (sbml-get-cpd-name name)) compartment (or boundary-condition "false"))
  (cond (annotation
	 (format stream ">~%")
	 (funcall annotation (get-cycid name) stream)
	 (format stream "  </species>~%"))
	(t
	 (format stream "/>~%"))))

(defun print-enzyme-annotation (enzyme stream)
  (awhen (genes-of-protein enzyme)
	 (format stream "      <annotation xmlns:fbml=\"http://arep.med.harvard.edu/fbml\">~%")
	 (loop for gene in it
	     do (format stream "         <fbml:gene id=\"~A\" name=\"~A\"/>~%"
			(get-sid gene)
			(get-cycid gene)))
	 (format stream "      </annotation>~%")))

(defun subpwys-of-pwy (pwy)
  (loop for subpwy? in (get-slot-values pwy 'reaction-list)
     if (class-all-type-of-p '|Pathways| subpwy?)
     append (cons subpwy? (subpwys-of-pwy subpwy?))))

(defun get-rxn-direction-from-pwy-layout (rxn pwy)
  (cadr (assoc :direction (cdr (assoc rxn (get-slot-values pwy 'reaction-layout))))))

(defun get-rxn-direction-from-pwy (rxn &optional (pwy *pathway*))
  (let ((pwys-of-rxn (get-slot-values rxn 'in-pathway)))
    (if (member pwy pwys-of-rxn :test 'fequal)
	(get-rxn-direction-from-pwy-layout rxn pwy)
	(loop for subpwy in (subpwys-of-pwy pwy)
	   when (member subpwy pwys-of-rxn :test 'fequal)
	   return (get-rxn-direction-from-pwy-layout rxn subpwy)))))


(defun print-reaction (sid name rxn-direction stream objective)
  (let* ((rxn (get-cycid name))
	 (reversible? (equal :BOTH rxn-direction)))
    (format stream 
	    "<reaction id=\"~A\" name=\"~A\" reversible=\"~A\">~%"
	    sid
	    name
	    (if reversible? "true" "false"))
    (print-list-of-reactants rxn rxn-direction stream)
    (print-list-of-products  rxn rxn-direction stream)
    (print-list-of-parameters rxn reversible? stream objective)
    ;;(print-list-of-modifiers rxn stream)
    (format stream "</reaction>~%")))

(defun print-list-of-parameters (rxn reversible? stream &optional objective )
    (let ((lower (if reversible? "-1000" "0"))
	  (upper "1000"))
      (format stream "		<kineticLaw>
			<math xmlns=\"http://www.w3.org/1998/Math/MathML\">
				<ci> FLUX_VALUE </ci>
			</math>
			<listOfParameters>
				<parameter id=\"LOWER_BOUND\" value=\"~A\" units=\"mmol_per_gDW_per_hr\"/>
				<parameter id=\"UPPER_BOUND\" value=\"~A\" units=\"mmol_per_gDW_per_hr\"/>
				<parameter id=\"OBJECTIVE_COEFFICIENT\" value=\"~D\"/>
				<parameter id=\"FLUX_VALUE\" value=\"0\" units=\"mmol_per_gDW_per_hr\"/>
				<parameter id=\"REDUCED_COST\" value=\"0.000000\"/>
			</listOfParameters>
		</kineticLaw>
"   lower upper (or objective 0))))

 
;;;kr:Dec-5-2008 Had to add the dir argument, to fix a serious and obscure bug.  Some rxns are unidirectionally :r2l
;;; and those were printed in the wrong direction.
;;;
(defun print-list-of-reactants (rxn dir stream)
  (let* ((slot (if (eql :r2l dir) 'RIGHT 'LEFT)))
    (awhen (get-slot-values rxn slot)
	   (format stream "   <listOfReactants>~%")
	   (loop for reactant in (get-slot-values rxn slot)
	       do (print-species-reference 
		   (get-transport-species rxn slot reactant)
		   (get-coefficient rxn slot reactant)
		   stream))
	   (format stream "   </listOfReactants>~%"))))
  
(defun print-list-of-modifiers (rxn stream)
  (awhen (enzymes-of-reaction rxn)
	 (format stream "   <listOfModifiers>~%")
	 (loop for enzyme in it
	     do (print-modifier-species-reference (get-sid enzyme) stream))
	 (format stream "   </listOfModifiers>~%")))

(defun print-modifier-species-reference (species stream)
  (format stream "      <modifierSpeciesReference species=\"~A\"/>~%" species))

(defun get-transport-species (rxn side species)
      (get-transport-sid species (compound-location species rxn side)))

;;;kr:Dec-5-2008 Had to add the dir argument, to fix a serious and obscure bug.  Some rxns are unidirectionally :r2l
;;; and those were printed in the wrong direction.
;;;
(defun print-list-of-products (rxn dir stream)
  (let* ((slot (if (eql :r2l dir) 'LEFT 'RIGHT)))
    (awhen (get-slot-values rxn slot)
	   (format stream "   <listOfProducts>~%")
	   (loop for product in (get-slot-values rxn slot)
	       do (print-species-reference
		   (get-transport-species rxn slot product)
		   (get-coefficient rxn slot product)
		   stream))
	   (format stream "   </listOfProducts>~%"))))

(defun print-species-reference (species stoichiometry stream)
  (format stream "      <speciesReference species=\"~A\" stoichiometry=\"~A\"/>~%"
	  (sbml-strip-html species)
	  stoichiometry))


;; get-transporter-sid
;; Returns an sid for the species
;; Arguments A species and a compartment
;; if the compartment is cco-cytoplasm default, do not alter the sid beyond symbol mangling
;; if the compartment is not cytoplasmic, then create an sid that incorporates the compartment name
;; jdz: Aug-30-2006  Wrote this to incorporate the Cell component ontology

(defun get-transport-sid (transporter compartment)
  (if (fequal compartment 'cco-cytoplasm)
      (get-sid transporter)
    (concatenate 'string  (get-sid transporter) "_" (get-sid compartment))))

  
  
;; param fname - a db object
;;  returns the frame name if fname is coercible to a frame,
;; otherwise returns fname
(defun get-sid (fname)
    (if (coercible-to-frame-p fname)
       (cyc2sid (get-frame-name fname))
       (cyc2sid fname)))

(defun get-cycid (sid)
  (let ((cycid (intern (sid2cyc sid))))
    (cond 
     ((coercible-to-frame-p sid)
      (get-frame-name sid))
     ((coercible-to-frame-p cycid)
      (get-frame-name cycid))
     (t cycid))))

;(defun cyc2sid (cyc)
;  (excl:replace-regexp
;   (replace-regexp (2string cyc)
;		   "[^0-9A-Za-z_]"
;		   "_")
;   "^\\([0-9]\\)"
;   "_\\1"))
   

(defun cyc2sid (cyc)
  (excl:replace-regexp 
   (replace-regexp (2string cyc)
		   (excl:compile-regexp "\\([^0-9A-Za-z_]\\)")
		   "__~d__" 
		   #'(lambda (x) 
		       (char-code (coerce x 'character))))
   (excl:compile-regexp "^\\([0-9]\\)")
   "_\\1"))
	

(defun sid2cyc (sid)
  (let ((compartment "periplasm")
	(sid (2string sid)))
    (intern (replace-regexp 
     (if (not (compartment-p sid compartment))
	 sid
       (subseq sid 0 (- (length sid)
			(length compartment))))
     "__\\([0-9]+\\)__"
     "~A"
     #'(lambda (x) (string (code-char (parse-integer x))))))))


;(defun sid2cyc (SId)
;  (let ((compartment "periplasm")
;	(SId (2string SId)))
;    (intern 
;     (substitute 
;      #\- #\_ 
;      (if (compartment-p SId  compartment)
;	  (subseq SId 0 (- (length SId) 
;			   (length compartment)
;			   1))
;	SId)))))

(defun 2string (fname)
  (cond ((coercible-to-frame-p fname)
	 (symbol-name (get-frame-name fname)))
	((symbolp fname)
	 (symbol-name fname))
	((stringp fname)
	 fname)))
  
;; get-coefficient takes a reaction frame and a compound frame and returns the coefficient of the metabolite in the reaction.
;;; The following version is a fix by Jeremy Zucker (from 20 Mar 2007) for a problem reported by Peifen for an AraCyc user.
;;; The rxn PECTINESTERASE-RXN had "N" as the stoichiometry, which the previous code did not convert to a number,
;;; which apparently is the requirement of SBML syntax, according to the validator at http://sbw.kgi.edu/Validate/

(defun get-coefficient (rxn side metabolite)
  (let ((coefficient (get-value-annot rxn side metabolite 'coefficient)))
    (cond ((fequal nil coefficient)
           (setq coefficient 1))
	  ((excl:match-regexp "[a-zA-Z]" (format nil "~d" coefficient))
	   (setq coefficient 1))
	  ;;kr:Mar-29-2007 It might make sense to retain this special case...
	  ((fequal '2N coefficient)
	   (setq coefficient 2))
	  ((excl:match-regexp "\\([0-9\\.]+\\)d\\([0-9]+\\)"
			      (format nil "~d" coefficient))
	   (setq coefficient (intern (excl:replace-regexp
				      (format nil "~d" coefficient)
				      "\\([0-9\\.]+\\)d\\([0-9]+\\)"
				      "\\1")))))
    coefficient))


(defun compartment-p (SId compartment)
  (eq (- (length SId) (length compartment)) 
      (mismatch SId compartment :from-end t)))

;;;kr:Jun-5-2009 Now that the REACTION-DIRECTION can store values directly on rxns, the previous logic
;;; testing for spontaneous rxns and the absence of enzrxns became obsolete.
;;;
(defun sbml-reversible-p (rxn)
  (if (rxn-potentially-reversible-p rxn) "true" "false")
  )

;;kr:Aug-30-2006 Renamed from (strip-html ...) , which other pieces of code started accidentally using,
;;; instead of (strip-html-tags ...)
;;; This one adds underscores, which is a little weird...
;;;
(defun sbml-strip-html (string)
  (excl:replace-regexp (2string string) (excl:compile-regexp "<.*>") "_" :shortest t))

(defun html-encode (string)
  (excl:replace-regexp
   (excl:replace-regexp
    (excl:replace-regexp 
     (excl:replace-regexp (2string string) "&" "&amp;" )
     "<" "&lt;")
    ">" "&gt;")
   "\"" "''"))


;; Function: replace-regexp - overloads excl:replace-regexp
;; Returns: A string
;; Arguments: string - the string to be replaced
;;            regexp - A regular expression
;;            replacement - a formatted string
;;            replacement-function - a function of the matched string
;; Example:  (replace-regexp "foo(x)" "[^a-z_]" "_") ==> foo_x_
;;           (replace-regexp "foo(x)" "[^a-z_]" "__~d__" 
;;                           #'(lambda (x) (code-char (coerce x 'character))))
;;           ==> foo__40__x__41__
;; Note: the replacement-function argument can cause a lot of naughtiness
;; if you are not careful with your regexp and replacement.  

;; For example not including an underscore in the last example is a BAD IDEA 
;; 

(defun replace-regexp (string regexp replacement &optional replacement-function)
  (if (fequal nil replacement-function)
      (excl:replace-regexp string regexp replacement)
    (multiple-value-bind (match-p whole-match match)
	(excl:match-regexp regexp string :return :string) 
      (declare (ignorable whole-match))
      (if (fequal nil match-p)
	  string
	(replace-regexp
	 (excl:replace-regexp string (escape-regexp whole-match)
		(format nil replacement 
			(funcall replacement-function match)))
	 regexp replacement replacement-function)))))


;; Function: escape-regexp - removes the special meanings from characters
;; Returns: A regular expression object
;; Arguments: string - the regular expression
;; Example: (escape-regexp "[") ==> "\\["

(defun escape-regexp (string) 
  (excl:compile-regexp (excl:replace-regexp string 
		       "\\(\\[\\|\\.\\|\\]\\|\\+\\|\\^\\|\\$\\)" 
		       (concatenate 'string "\\" string))))

  
(defun html-decode (string)
  (excl:replace-regexp
   (excl:replace-regexp 
    (excl:replace-regexp (2string string) "&gt;" ">" )
    "&lt;" "<")
   "&amp;" "&"))


;;;==============================================================

(defun com-sbml-export ()
  (let ((stream *standard-output*))
    (clim:accepting-values (stream :own-window t :resynchronize-every-pass t
				   :resize-frame t
				   :label "SBML Export"
				   :initially-select-query-identifier :sbml-subset)
      (clim:formatting-table (stream)
	(clim:formatting-row (stream)
	  (format-cell-text stream "All Reactions?:" :align-y :center :align-x :right)
	  (format-cell-text stream " ")
	  (clim:formatting-cell (stream :align-y :center :align-x :left)
	    (setq *sbml-reaction-subset*
	      (clim:accept '(clim:member-alist (("All Reactions" :all-reactions)
						("Only Reactions With Associated Enzymes" :only-with-enzymes)))
			   :stream stream :default *sbml-reaction-subset*
			   :prompt nil :view clim:+option-pane-view+
			   :query-identifier :sbml-subset))))
	(clim:formatting-row (stream)
	  (format-cell-text stream "Reaction types to be exported:" :align-y :top :align-x :right)
	  (format-cell-text stream " ")
	  (clim:formatting-cell (stream :align-y :top :align-x :left)
	    (setq *sbml-reaction-type*
	      (clim:accept '(clim:member-alist (("All reactions" :all)
						("Enzyme-catalyzed reactions" :enzyme)
						("Transport reactions" :transport)
						("Small-molecule reactions" :metab-smm)))
			   :stream stream :default *sbml-reaction-type*
			   :prompt nil :view clim:+option-pane-view+
			   :query-identifier :sbml-type))))
	(clim:formatting-row (stream)
	    (format-cell-text stream "Output file:" :align-y :center :align-x :right)
	    (clim:formatting-cell (stream :align-y :center :align-x :left)
	      (clim:accept-values-command-button (stream) "Browse"
		(let ((file (select-file-w-default *sbml-export-file-name* :save :title "Select file for export")))
		  (when file
		    (setq *sbml-export-file-name* (namestring file))))))
	    (clim:formatting-cell (stream :align-y :center :align-x :left)
	      (setq *sbml-export-file-name*
		(accept-string stream nil *sbml-export-file-name* :width 400 :query-id :sbml-file-name)))))))
    (let* ((maybe-with-enzymes (when (eq *sbml-reaction-subset* :only-with-enzymes)
				 (all-rxns :enzyme)))
	   (initial-reaction-set (all-rxns *sbml-reaction-type*))
	   (reaction-set (if (eq *sbml-reaction-subset* :all-reactions)
			     initial-reaction-set
			   (intersection initial-reaction-set maybe-with-enzymes))))
      (handler-case
	  (2cobra *sbml-export-file-name* reaction-set)
	(file-error (c)
	  (clim-warn-user (format nil "Could not save to file ~A.~%Error: ~A"
				  *sbml-export-file-name* c))))
      ))
